home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / Preinstalled MacPerl (FAT) / t / op / misc.t < prev    next >
Encoding:
Text File  |  1995-10-30  |  3.5 KB  |  190 lines  |  [TEXT/McPL]
  1. #!./perl
  2.  
  3. chdir 't' if -d 't';
  4. chdir '::' unless -d 'op';
  5. # @INC = "../lib";
  6. # $ENV{PERL5LIB} = "../lib";
  7. @INC = "::lib";
  8. $ENV{PERL5LIB} = "::lib";
  9.  
  10. $|=1;
  11.  
  12. undef $/;
  13. @prgs = split "\n########\n", <DATA>;
  14. print "1..", scalar @prgs, "\n";
  15.  
  16. $tmpfile = "misctmp000";
  17. 1 while -f ++$tmpfile;
  18. END { unlink $tmpfile if $tmpfile; }
  19.  
  20. for (@prgs){
  21.     my $switch;
  22.     if (s/^\s*-\w+//){
  23.     $switch = $&;
  24.     }
  25.     my($prog,$expected) = split(/\nEXPECT\n/, $_);
  26. #    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
  27.     open TEST, "| ::perl $switch ∑$tmpfile";
  28.     print TEST $prog, "\n";
  29.     close TEST;
  30.     $status = $?;
  31. #    $results = `cat $tmpfile`;
  32.     $results = `catenate $tmpfile`;
  33.     $results =~ s/\n+$//;
  34.     $expected =~ s/\n+$//;
  35.     if ( $results ne $expected){
  36.     print STDERR "PROG: $switch\n$prog\n";
  37.     print STDERR "EXPECTED:\n$expected\n";
  38.     print STDERR "GOT:\n$results\n";
  39.     print "not ";
  40.     }
  41.     print "ok ", ++$i, "\n";
  42. }
  43.  
  44. __END__
  45. $foo=undef; $foo->go;
  46. EXPECT
  47. # Can't call method "go" without a package or object reference.
  48. File 'Dev:Stdin'; Line 1
  49. ########
  50. BEGIN
  51.         {
  52.         "foo";
  53.         }
  54. ########
  55. -P 
  56. use POSIX;
  57. ########
  58. $array[128]=1
  59. ########
  60. $x=0x0eabcd; print $x->ref;
  61. EXPECT
  62. # Can't call method "ref" without a package or object reference.
  63. File 'Dev:Stdin'; Line 1
  64. ########
  65. chop ($str .= <STDIN>);
  66. ########
  67. close ($banana);
  68. ########
  69. $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
  70. EXPECT
  71. 25
  72. ########
  73. eval {sub bar {print "In bar";}}
  74. ########
  75. die; # system "::perl -ne 'print if eof' Dev:Null"
  76. ########
  77. chop($file = <>);
  78. ########
  79. package N;
  80. sub new {my ($obj,$n)=@_; bless \$n}  
  81. $aa=new N 1;
  82. $aa=12345;
  83. print $aa;
  84. EXPECT
  85. 12345
  86. ########
  87. %@x=0;
  88. EXPECT
  89. # Can't coerce HASH to string in repeat.
  90. File 'Dev:Stdin'; Line 1
  91. ########
  92. $_="foo";
  93. printf(STDOUT "%s\n", $_);
  94. EXPECT
  95. foo
  96. ########
  97. push(@a, 1, 2, 3,)
  98. ########
  99. quotemeta ""
  100. ########
  101. for ("ABCDE") {
  102.  ⊂
  103. s/./&sub($&)/eg;
  104. print;}
  105. sub sub {local($_) = @_;
  106. $_ x 4;}
  107. EXPECT
  108. # Modification of a read-only value attempted.
  109. File 'Dev:Stdin'; Line 3
  110. ########
  111. BEGIN { @INC = "::lib"; }
  112. package FOO;sub new {bless {FOO => BAR}};
  113. package main;
  114. use strict vars;  
  115. my $self = new FOO;
  116. print $$self{FOO};
  117. EXPECT
  118. BAR
  119. ########
  120. $_="foo";
  121. s/.{1}//s;
  122. print;
  123. EXPECT
  124. oo
  125. ########
  126. print scalar ("foo","bar")
  127. EXPECT
  128. bar
  129. ########
  130. sub by_number { $a <=> $b; };# inline function for sort below
  131. $as_ary{0}="a0";
  132. @ordered_array=sort by_number keys(%as_ary);
  133. ########
  134. sub NewShell
  135. {
  136.   local($Host) = @_;
  137.   my($m2) = $#Shells++;
  138.   $Shells[$m2]{HOST} = $Host;
  139.   return $m2;
  140. }
  141.  
  142. sub ShowShell
  143. {
  144.   local($i) = @_;
  145. }
  146.  
  147. &ShowShell(&NewShell(beach,Work,"+0+0"));
  148. &ShowShell(&NewShell(beach,Work,"+0+0"));
  149. &ShowShell(&NewShell(beach,Work,"+0+0"));
  150. ########
  151.    {
  152.        package FAKEARRAY;
  153.    
  154.        sub TIEARRAY
  155.        { print "TIEARRAY @_\n"; 
  156.          die "bomb out\n" unless $count ++ ;
  157.          bless ['foo'] 
  158.        }
  159.        sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
  160.        sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
  161.        sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
  162.    }
  163.    
  164. eval 'tie @h, FAKEARRAY, fred' ;
  165. tie @h, FAKEARRAY, fred ;
  166. EXPECT
  167. TIEARRAY FAKEARRAY fred
  168. TIEARRAY FAKEARRAY fred
  169. DESTROY 
  170. ########
  171. BEGIN { die "phooey\n" }
  172. EXPECT
  173. # # phooey
  174. BEGIN failed--compilation aborted.
  175. File 'Dev:Stdin'; Line 1
  176. ########
  177. BEGIN { 1/$zero }
  178. EXPECT
  179. # # Illegal division by zero.
  180. File 'Dev:Stdin'; Line 1
  181. BEGIN failed--compilation aborted.
  182. File 'Dev:Stdin'; Line 1
  183. ########
  184. BEGIN { undef = 0 }
  185. EXPECT
  186. # # Modification of a read-only value attempted.
  187. File 'Dev:Stdin'; Line 1
  188. BEGIN failed--compilation aborted.
  189. File 'Dev:Stdin'; Line 1
  190.